home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 0800 / finger.pas < prev    next >
Pascal/Delphi Source File  |  1997-04-10  |  7KB  |  248 lines
  1. {
  2.   Public Domain  - Please leave this notice intact.
  3.   Mike Caughran Cedar Island Software OCT 1994
  4.   All the usual disclaimers apply.
  5.   Implement a finger client using Borland Pascal 7
  6.  
  7.   71034.2371@compuserve.com
  8.   907-789-9030 voice
  9.   907-789-1694 bbs
  10. }
  11.  
  12. {
  13.   Finger is one of the easiest clients to implement.
  14.   WinCRT is used also for clarity.  (Eschew Obfuscation.)
  15.   Finger usually resides on socket 79.
  16. }
  17.  
  18. program finger;
  19.  
  20. uses winsock, strings, wincrt, winprocs, wintypes;
  21.  
  22. var
  23.   myVerReqd : word;
  24.   myWSAData : WSADATA;
  25.   s : String[255];
  26.   i : integer;
  27.   CharArray: array[0..255] of char;
  28.   HostNameArray: array[0..255] of char;
  29.   FingerSocket : tSOCKET;
  30.   err : integer;
  31.   FingerPort : word;
  32.   Remote_Addr: sockaddr_in;
  33.   Remote_Host: Phostent;
  34.  
  35. procedure CleanUp; Forward;
  36.  
  37. {----------------------------------------}
  38. { -- Start of code to SubClass WinCRT -- }
  39. {----------------------------------------}
  40. var
  41.   OldWndProc : TFarProc;
  42. const
  43.   hCRTWnd : HWND        = 0;
  44.   cm_Exit               = 100;
  45.   cm_About              = 101;
  46.  
  47. function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
  48. begin
  49.   case Message of
  50.     wm_Char        : begin
  51.                        if wParam=vk_Escape then begin
  52.                          CleanUp;
  53.                          DoneWinCRT;
  54.                        end;
  55.                      end;
  56.     wm_Command     : begin
  57.       case WParam of
  58.     cm_About:   MessageBox(Window,
  59. 'Finger Client'#13'Public Domain 1994 by'#13'Mike Caughran'#13'Cedar Island Software',
  60.                     'Pascal Finger Client',mb_IconExclamation);
  61.     cm_Exit:    begin
  62.                       CleanUp;
  63.                       DoneWinCrt;
  64.                     end;
  65.       end;
  66.     end;
  67.   end;
  68.   WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
  69. end;
  70.  
  71. procedure MakeMenu;
  72. var
  73.   Menu      : HMenu;
  74.   FileMenu  : HMenu;
  75. begin
  76.   Menu := CreateMenu;
  77.   FileMenu := CreateMenu;
  78.   AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
  79.   AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
  80.   AppendMenu(Menu, mf_Enabled, cm_About, 'About');
  81.   SetMenu(hCRTWnd,Menu);
  82. end;
  83.  
  84. procedure myInitWinCRT;
  85. var
  86.   hInstance : THandle;
  87.   WindowClass : TWndClass;
  88. begin
  89.   GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
  90.   UnregisterClass('TPWinCRT', hInstance);
  91.   WindowClass.hIcon := LoadIcon(0, idi_Exclamation);
  92.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  93.   OldWndProc := tFarProc(WindowClass.lpfnWndProc);
  94.   WindowClass.lpfnWndProc := @WindowProc;
  95.   RegisterClass(WindowClass);
  96.   InactiveTitle := '%s';
  97.   StrCopy(WindowTitle,'Pascal Finger Client V1.0');
  98.   InitWinCrt;
  99.   hCRTWnd := GetActiveWindow;
  100.   MakeMenu;
  101. end;
  102. {--------------------------------------}
  103. { -- End of code to SubClass WinCRT -- }
  104. {--------------------------------------}
  105.  
  106.  
  107. {$I ERROR.INC}
  108.  
  109. procedure StartUp;
  110. begin
  111.   myVerReqd:=$0101;
  112.   Writeln('Winsock version required : ',hibyte(myVerReqd),'.',lobyte(myVerReqd));
  113.   if WSAStartup(myVerReqd,@myWSAData) <>0 then Abort('WSAStartup');
  114. end;
  115.  
  116. procedure ShowWinSockInfo;
  117. begin
  118.   Write('Winsock Version found: ');
  119.   Writeln(lobyte(myWSAData.wVersion),'.',lobyte(myWSAData.wHighVersion));
  120.   S := StrPas(myWSAData.szDescription);
  121.   Writeln('Description=',S);
  122.   S := StrPas(myWSAData.szSystemStatus);
  123.   Writeln('SystemStatus=',S);
  124.   Writeln('MaxSockets=',word(myWSAData.iMaxSockets));
  125.   Writeln('MaxUdpDg=',word(myWSAData.iMaxUdpDg));
  126.   Write('VendorInfo= ');
  127.     if myWSAData.lpVendorInfo <> NIL then begin
  128.       writeln(myWSAData.lpVendorInfo);
  129.     end else writeln('NULL');
  130.   Write('Local Hostname=');
  131.   if (gethostname(@CharArray,255) <> 0) then Error('GetHostName')
  132.     else writeln(CharArray);
  133. end;
  134.  
  135. procedure PromptForHostname;
  136. var
  137.   aString : String;
  138. begin
  139.   writeln;
  140.   write('Remote Hostname : ');
  141.   readln(aString);
  142.   strPcopy(HostNameArray, aString);
  143.   Remote_Host :=gethostbyname(HostNameArray);
  144.   if Remote_Host = Nil then begin
  145.     Writeln; Writeln('Can''t find host.'); Writeln;
  146.     Abort('GetHostByName');
  147.   end
  148.   else begin
  149.     Remote_Host^.h_addr := Remote_Host^.h_addr_list^;             {h_addr := h_addr_list[0]}
  150.     {
  151.     Writeln(byte(Remote_Host^.h_addr[0]),'.',
  152.             byte(Remote_Host^.h_addr[1]),'.',
  153.             byte(Remote_Host^.h_addr[2]),'.',
  154.             byte(Remote_Host^.h_addr[3]));
  155.     }
  156.   end;
  157. end;
  158.  
  159. procedure FindFingerService;
  160. var
  161.   pSE : pServEnt;
  162. begin
  163.   FingerPort := 0;
  164.   pSE := getservbyname('finger','tcp');
  165.   if pSE = nil then begin
  166.     Error('GetServByName'); Writeln;
  167.     Writeln('Finger is usually on port 79.  Check Services table.');
  168.   end
  169.   else begin
  170.     FingerPort := htons(pSE^.s_port);
  171.     Writeln('Using finger service on port ',FingerPort);
  172.   end;
  173. end;
  174.  
  175. procedure CreateSocket;
  176. begin
  177.   FingerSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  178.   If FingerSocket = INVALID_SOCKET then Abort('Can''t CreateSocket')
  179.   else
  180.     Writeln('Socket descriptor allocated : ',ord(FingerSocket));
  181. end;
  182.  
  183. procedure ConnectToPort;
  184. begin
  185.   Remote_addr.sin_family := PF_INET;
  186.   Remote_addr.sin_port := htons(FingerPort);
  187.   Remote_addr.sin_addr.S_un_b.s_b1:=Remote_Host^.h_addr[0];
  188.   Remote_addr.sin_addr.S_un_b.s_b2:=Remote_Host^.h_addr[1];
  189.   Remote_addr.sin_addr.S_un_b.s_b3:=Remote_Host^.h_addr[2];
  190.   Remote_addr.sin_addr.S_un_b.s_b4:=Remote_Host^.h_addr[3];
  191.   writeln('Connecting to ',inet_ntoa(Remote_Addr.sin_addr));
  192.   if connect(FingerSocket, sockaddr(Remote_Addr), SizeOf(Remote_Addr)) <> 0 then
  193.   begin
  194.     CloseSocket(FingerSocket);
  195.     Abort('Connect');
  196.   end;
  197. end;
  198.  
  199.  
  200. procedure SendTxt(ABuff : PChar);
  201. begin
  202.   if send(FingerSocket, ABuff, StrLen(ABuff), 0) < StrLen(ABuff) then
  203.     Error('Send');
  204. end;
  205.  
  206. function RecvTxt(ABuff : PChar) : boolean;
  207. var
  208.   rc,i : integer;
  209. begin
  210.   RecvTxt := True;
  211.   rc := recv(FingerSocket, ABuff, 1024, 0);
  212.   if rc = SOCKET_ERROR then begin
  213.     RecvTxt := False;
  214.     Error('Recv');
  215.   end
  216.   else if rc = 0 then begin
  217.     ABuff := '';
  218.     RecvTxt := False;
  219.   end;
  220. end;
  221.  
  222.  
  223. procedure CleanUp;
  224. begin
  225.   if WSACleanup <> 0 then Error('WSACleanup');
  226. end;
  227.  
  228. var
  229.   Buff : array [0..1024] of char;
  230.  
  231. procedure DoFinger;
  232. begin
  233.   StartUp;
  234.   ShowWinsockInfo;
  235.   PromptForHostname;
  236.   FindFingerService;
  237.   CreateSocket;
  238.   ConnectToPort;
  239.   writeln;
  240.   SendTxt('Hello from finger world'#13#10);
  241.   while RecvTxt(@Buff) do write(Buff);
  242.   CleanUp;
  243. end;
  244.  
  245. begin
  246.   MyInitWinCRT;
  247.   DoFinger;
  248. end.